Amiga Tools 3/Amiga Tools 3.iso/rexx/joinpaths.pvrx

Text File | 1992-08-25 | 5.0 KB | 221 lines

/* JoinPaths.pvrx---Prompt user to select an end point each
    from two paths by which the two paths should be joined.
   Author: Jeff Blume
   Copyright © 1991 by Stylus, Inc.

   Suggested "ProVector.pvrx" entries:

    'DefineKey J "JoinPaths MENU"'
    'Define "JoinPaths  Ctrl-J" "JoinPaths MENU"'

*/

/* Get the argument list to see whether this is a MENU, or an OK */
arg arglist
Cmd = word(arglist,1)

options results

/* Try to get exclusive lock on project window.
    If can't get lock, not polite to interrupt. */
'Lock'
if RC ~= 0 then exit

/* This loop is called from the menu */
if Cmd = 'MENU' then
DO
    /* Magnetize Sel Objs for better coord identification.*/
    'SelectList' Sel; SelN = Result
    if SelN ~= 2 then do
        RC = 100
        call Error "Must Select Two Objects!"
        end
    else 'Magnetize' SelN Sel
    'Prompt "Click Two Points To Join:"'
    'GetUserData 0 2 2 "JoinPaths OK" ""'
END
/* end "MENU" loop */

/* This was called from GetUserData */
if Cmd = 'OK' then
DO
    'EndPrompt'
    'GetInputPoints Pts'
    'PushUndo'
    'SelectList' Sel; SelN = Result

    'Prompt "Looking for points."'
    /* Identify objects and points */
    do k=0 to 1
        /* First try the easy way */
        'ObjectAt' Pts.k.X Pts.k.Y; Obj.k = Result  /* Ctrl-Pt may return 0 or wrong obj! */
        if Result = 0 then FindPT = WalkSelected()    /* Then the hard way */
        else FindPt = TestPoints(Obj.k,"ONLY")
        call TestFindPt
    end
    'EndPrompt'

    'Prompt "Joining Objects"'
    /* Check that path direction is right for joining     */
    /* One selected point must be first point of object, */
    /* but both can't be. 1st-Pt=Indicator needs offset. */
    if ObjPts.0.0.X = "INDICATOR" then FirstA = 1
        else FirstA = 0
    if ObjPts.1.0.X = "INDICATOR" then FirstB = 1
        else FirstB = 0
    select
        when Idx.0 = FirstA & Idx.1 = FirstB then,
            call  AddPoints 0,0,1
        when Idx.0 ~= FirstA & Idx.1 ~= FirstB then,
            call  AddPoints 1,0,1
        when Idx.0 = FirstA & Idx.1 ~= FirstB then,
            call  AddPoints R,1,0
        when Idx.0 ~= FirstA & Idx.1 = FirstB then,
            call  AddPoints R,0,1
        otherwise NOP
    end /* SELECT END */

/*
call open STDOUT,"RAM:RxOut.txt",W
call open STDERR,"RAM:RxErr.txt",W
trace ?R
*/

    /* Clean up old objects */
    'GetCurrAttrs' AttrsCur    /* Store current attributes */
    'GetAttrs' Obj.0 AttrsObj    /* Store object attributes */
    'TypeOf Sel.0'; ObjType = Result
    /* De-Magnetize and delete seed objs */
    'Magnetize' 0 Sel
    do s=0 to 1
        'Delete' Sel.s
    end

    /* DRAW NEW MERGED OBJ! */
    'SetCurrAttrs' AttrsObj    /* Set object attributes */
    if ObjType = "Polyline" then 'Polyline' NumJoin ObjPts.A
    else  'Polygon' NumJoin ObjPts.A
    'SetCurrAttrs' AttrsCur    /* Restore current attributes */

    'EndPrompt'
    'Repair'

END
/* end "OK" loop */

'UnLock'
EXIT

ERROR:
    arg ErrTxt
    if RC ~= 0 & ErrTxt ~= "" then 'GetBool ErrTxt "Cancel" "Cancel"'
    SelN = 0
    'Magnetize' SelN Sel
    'EndPrompt'
    'UnLock'
    exit

WALKSELECTED:
    do i = 0 to SelN-1
        FindPt = TestPoints(Sel.i,i)
        select
            when FindPt = "FOUND" then return "FOUND"
            when i = SelN-1 & FindPt = "TEXTOBJ" then return "TEXTOBJ"
            when i = SelN-1 then return "CAN'T FIND"
            otherwise iterate
        end /*SELECT END*/
    end /* "i" DO END */

TESTPOINTS:
    arg Obj,Count
    'GetPoints' Obj ObjPts.k; NumPts=Result
    if RC=18 & Count="ONLY" then call Error "CAN'T JOIN TEXT OR GROUP"
    if RC = 18 then return "TEXTOBJ"

    do j = 0 to NumPts-1
        select
            when ObjPts.k.j.X = Pts.k.X & ObjPts.k.j.Y = Pts.k.Y then
                do
                    Idx.k = j
                    NmPts.k = NumPts
                    return "FOUND"
                end
            when j = NumPts-1 & Count = "ONLY" then,
                return "WRONGOBJ"
            when j = NumPts-1 then return "TRYAGAIN"
            otherwise iterate
        end /*SELECT END*/
    end /* "j" DO END */

TESTFINDPT:
    if FindPt ~= "FOUND" then select
        when FindPt = "WRONGOBJ" then
            do
                RC = 100
                call Error "NO POINT; MUST BE FIRST OR LAST"
            end
        when FindPt = "TEXTOBJ" then
            do
                RC = 100
                call Error "TEXT OR GROUP (OR NO POINT)."
            end
        otherwise
            do
                RC=100
                call Error "NO POINT"
            end
        end /*SELECT END*/
        return

ADDPOINTS:
    /* Add the first object's points together   */
    /* "R" is object to reverse */
    /* "A" is base object to which "B" is added */
    arg R, A, B
    if R ~= "R" then call Reverse R
    NumJoin = NmPts.A + NmPts.B
    t = NmPts.A
    do s = 0 to NmPts.B - 1
        ObjPts.A.t.X = ObjPts.B.s.X
        ObjPts.A.t.Y = ObjPts.B.s.Y
        t = t + 1
    end
    return

REVERSE:
    /* Reverse order of object */
    arg R
    SkipInd = "FALSE"
    do s = 0  to NmPts.R - 1
        t = NmPts.R - (s+1)
        if SkipInd ~= "FALSE" then t = t + 1
        if t = SkipInd then do
            t = t - 1
            SkipInd = "FALSE"
            end
        /*if t = SkipInd & t >= 1 then t = t - 1*/
        if ObjPts.R.t.X = "INDICATOR" then do
            s = s - 4
            JoinedPts.s.X = ObjPts.R.t.X
            JoinedPts.s.Y = ObjPts.R.t.Y
            SkipInd = t
            iterate s
            end
        JoinedPts.s.X = ObjPts.R.t.X
        JoinedPts.s.Y = ObjPts.R.t.Y
    end

    /* Put points back in original array */
    do s = 0  to NmPts.R - 1
        ObjPts.R.s.X = JoinedPts.s.X
        ObjPts.R.s.Y = JoinedPts.s.Y
    end
    return

/*
BUGS:

    1. Will not always join points that are coincident, at least in FFP
        (from old note buried on desk - still true?)

*/